perm filename PREDIC.LSP[BNF,JRA]2 blob
sn#024550 filedate 1973-02-14 generic text, type T, neo UTF8
00100
00200
00300 (DEFPROP <PREDIC>
00400 (LAMBDA NIL
00500 (NLRR (QUOTE PREDIC)
00600 (FUNCTION
00700 (LAMBDA NIL
00800 (COND ((AND (SPWD ANCESTRY)) (QUOTE ANCESTRY))
00900 ((AND (SPWD NONE)) (QUOTE NONE))
01000 ((AND (SPWD VINE)) (QUOTE VINE))
01100 ((AND (SPWD UNIT)) (QUOTE UNIT))
01200 ((AND (SPWD P1)) (QUOTE ALLPOS))
01300 ((AND (SPWD P2)) (QUOTE ALLNEG))
01400 ((AND (SPWD SUPPORT) (CH /[) (<C>) (CH /])) (CONS (QUOTE SUPPORT) (STK 1)))
01500 ((AND (SPWD DEPTH) (CH /[) (<NUMBER>) (CH /]))
01600 (CONS (QUOTE GREATERP)
01700 (CONS (CONS (QUOTE DEPTH) (CONS (CONS (QUOTE CDR) (CONS (QUOTE C) NIL)) NIL))
01800 (CONS (STK 1) NIL))))
01900 ((AND (SPWD LENGTH) (CH /[) (<NUMBER>) (CH /]))
02000 (CONS (QUOTE GREATERP)
02100 (CONS (CONS (QUOTE LENGTH) (CONS (CONS (QUOTE CDR) (CONS (QUOTE C) NIL)) NIL))
02200 (CONS (STK 1) NIL))))
02300 ((AND (SPWD MODEL) (CH /[) (<PREDLST>) (CH ;) (<PREDLST1>) (CH /]))
02400 (CONS (QUOTE MODEL) (CONS (STK 3) (CONS (STK 1) NIL))))
02500 ((AND (SPWD EQUALITY) (CH /[) (<OP>) (CH /,) (<NUMBER>) (CH /]))
02600 (CONS (QUOTE EQUALITY) (CONS (STK 3) (CONS (STK 1) NIL))))
02700 ((AND (SPWD DEMOD) (CH /[) (<CLAUSES>) (CH /,) (<NUMBER>) (CH /]))
02800 (CONS (QUOTE DEMOD) (CONS (STK 3) (CONS (STK 1) NIL))))
02900 ((AND (SPWD DEFMODEL) (CH /[) (SPWD ID) (CH /])) (CONS (QUOTE DEFMODEL) (QUOTE ID)))
03000 ((AND (CH /@) (<LISPR>)) (STK 0))
03100 ((AND (<TERM0>) (<OPR>) (<TERM>)) (CONS (STK 1) (CONS (STK 2) (CONS (STK 0) NIL))))
03200 (*NIL*))))))
03300 EXPR)
03400
03500 (DEFPROP <PREDLST1>
03600 (LAMBDA NIL (NLRR (QUOTE PREDLST1) (FUNCTION (LAMBDA NIL (COND ((AND (<PREDLST>)) (STK 0)) (*NIL*))))))
03700 EXPR)
03800
03900 (DEFPROP <PREDLST>
04000 (LAMBDA NIL
04100 (NLRR (QUOTE PREDLST)
04200 (FUNCTION
04300 (LAMBDA NIL
04400 (COND ((AND (<ID>) (CH /,) (<PREDLST>)) (CONS (STK 2) (STK 0)))
04500 ((AND (<ID>)) (STK 0))
04600 ((AND) NIL)
04700 (*NIL*))))))
04800 EXPR)
04900
05000 (DEFPROP >PREDIC<
05100 (LAMBDA(%N)
05200 (OUTRUL %N
05300 (FUNCTION
05400 (LAMBDA NIL
05500 (COND ((EQ (QUOTE ANCESTRY) (STK1)) (QUOTE ANCESTRY))
05600 ((EQ (QUOTE NONE) (STK1)) (QUOTE NONE))
05700 ((EQ (QUOTE VINE) (STK1)) (QUOTE VINE))
05800 ((EQ (QUOTE UNIT) (STK1)) (QUOTE UNIT))
05900 ((EQ (QUOTE ALLPOS) (STK1)) (QUOTE P1))
06000 ((EQ (QUOTE ALLNEG) (STK1)) (QUOTE P2))
06100 ((AND (MATCH (QUOTE (SUPPORT . *))) (>C< 0))
06200 (LIST (QUOTE SUPPORT) (QUOTE (:CH /[)) (STK0) (QUOTE (:CH /]))))
06300 ((AND (MATCH (QUOTE (GREATERP (DEPTH (CDR C)) *))) (>NUMBER< 0))
06400 (LIST (QUOTE DEPTH) (QUOTE (:CH /[)) (STK0) (QUOTE (:CH /]))))
06500 ((AND (MATCH (QUOTE (GREATERP (LENGTH (CDR C)) *))) (>NUMBER< 0))
06600 (LIST (QUOTE LENGTH) (QUOTE (:CH /[)) (STK0) (QUOTE (:CH /]))))
06700 ((AND (MATCH (QUOTE (MODEL * *))) (>PREDLST< 1) (>PREDLST1< 0))
06800 (LIST (QUOTE MODEL) (QUOTE (:CH /[)) (STK1) (QUOTE (:CH ;)) (STK0) (QUOTE (:CH /]))))
06900 ((AND (MATCH (QUOTE (EQUALITY * *))) (>OP< 1) (>NUMBER< 0))
07000 (LIST (QUOTE EQUALITY) (QUOTE (:CH /[)) (STK1) (QUOTE (:CH /,)) (STK0) (QUOTE (:CH /]))))
07100 ((AND (MATCH (QUOTE (DEMOD * *))) (>CLAUSES< 1) (>NUMBER< 0))
07200 (LIST (QUOTE DEMOD) (QUOTE (:CH /[)) (STK1) (QUOTE (:CH /,)) (STK0) (QUOTE (:CH /]))))
07300 ((AND (MATCH (QUOTE (DEFMODEL . ID))))
07400 (LIST (QUOTE DEFMODEL) (QUOTE (:CH /[)) (QUOTE ID) (QUOTE (:CH /]))))
07600 ((AND (MATCH (QUOTE (* * *))) (>OPR< 2) (>TERM0< 1) (>TERM< 0))
07700 (LIST (STK1) (STK2) (STK0)))
07750 ((>LISPR< 1)(LIST(QUOTE(:CH /@))(STK1))))))))
07800 EXPR)
07900
08000 (DEFPROP >PREDLST1<
08100 (LAMBDA (%N) (OUTRUL %N (FUNCTION (LAMBDA NIL (COND ((>PREDLST< 1) (STK1)))))))
08200 EXPR)
08300
08400 (DEFPROP >PREDLST<
08500 (LAMBDA(%N)
08600 (OUTRUL %N
08700 (FUNCTION
08800 (LAMBDA NIL
08900 (COND ((EQ (QUOTE NIL) (STK1)) FOOBAZ)
09000 ((AND (MATCH (QUOTE (* . *))) (>ID< 1) (>PREDLST< 0)) (LIST (STK1) (QUOTE (:CH /,)) (STK0)))
09100 ((>ID< 1) (STK1)))))))
09200 EXPR)